home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / AmigaE / Src / Rkrm / Graphics_Libraries / Primitives / genlockdemo.e next >
Encoding:
Text File  |  1995-09-20  |  14.4 KB  |  404 lines

  1. -> genlockdemo.e - Genlock VideoControl example.
  2.  
  3. ->>> Header (globals)
  4. OPT PREPROCESS
  5.  
  6. MODULE 'gadtools',
  7.        'exec/libraries',
  8.        'graphics/displayinfo',
  9.        'graphics/gfxbase',
  10.        'graphics/modeid',
  11.        'graphics/text',
  12.        'graphics/videocontrol',
  13.        'graphics/view',
  14.        'intuition/intuition',
  15.        'intuition/screens',
  16.        'libraries/gadtools',
  17.        'utility/tagitem'
  18.  
  19. ENUM ERR_NONE, ERR_CTXT, ERR_ECS, ERR_GAD, ERR_KICK, ERR_LIB, ERR_SCRN,
  20.      ERR_VIS, ERR_WIN
  21.  
  22. RAISE ERR_CTXT IF CreateContext()=NIL,
  23.       ERR_GAD  IF CreateGadgetA()=NIL,
  24.       ERR_KICK IF KickVersion()=FALSE,
  25.       ERR_LIB  IF OpenLibrary()=NIL,
  26.       ERR_SCRN IF OpenScreenTagList()=NIL,
  27.       ERR_VIS  IF GetVisualInfoA()=NIL,
  28.       ERR_WIN  IF OpenWindowTagList()=NIL,
  29.       "MEM"    IF String()=NIL
  30.  
  31. -> 'libraries/gadtools' does not define a library name.
  32. #define GADTOOLSNAME 'gadtools.library'
  33.  
  34. -> Some gadget ID's
  35. ENUM BORDERBLANK_ID=16, BORDERNOTRANS_ID, BITPLANEKEY_ID, CHROMAPLANE_ID,
  36.      CHROMAKEY_ID
  37.  
  38. -> E-Note: get the right type to use gfxbase
  39. DEF gfx:PTR TO gfxbase
  40. ->>>
  41.  
  42. ->>> PROC main()
  43. PROC main() HANDLE
  44.   DEF genscreen=NIL:PTR TO screen, controlwindow=NIL:PTR TO window,
  45.       glist=NIL, gadget:PTR TO gadget, hitgadget:PTR TO gadget,
  46.       vp:PTR TO viewport, viewlord:PTR TO view, vi=NIL, ng:PTR TO newgadget,
  47.       -> E-Note: C version is over-cautious about the size of vtags
  48.       imsg:PTR TO intuimessage, vtags[22]:ARRAY OF tagitem,
  49.       gadgetPtrs[21]:ARRAY OF LONG, iclass, icode, i, j, abort=FALSE, isPAL,
  50.       gfx:PTR TO gfxbase
  51.   gfx:=gfxbase  -> E-Note: set-up correct typed gfxbase
  52.   KickVersion(37)
  53.   gadtoolsbase:=OpenLibrary(GADTOOLSNAME, 37)
  54.   IF 0=(gfx.chiprevbits0 AND GFXF_HR_DENISE) THEN Raise(ERR_ECS)
  55.   -> Check if the user happens to prefer PAL or if this is a true PAL system.
  56.   isPAL:=checkPAL('Workbench')
  57.  
  58.   -> Open a 'standard' HIRES screen.
  59.   genscreen:=OpenScreenTagList(NIL,
  60.                         -> Give me 3D look window (I'll use a quiet screen).
  61.                        [SA_PENS, [0, 1, 1, 2, 1, 3, 1, 0, 3, -1]:INT,
  62.                         SA_DISPLAYID, HIRES_KEY,
  63.                         SA_DEPTH, 4,
  64.                         -> Give me a lot of border.
  65.                         SA_WIDTH, 640,
  66.                         SA_HEIGHT, IF isPAL THEN 256 ELSE 200,
  67.                         SA_OVERSCAN, 0,
  68.                         -> Hold the titlebar, please.
  69.                         SA_QUIET, TRUE,
  70.                         -> Give me a sysfont 1 as default rastport font.
  71.                         SA_SYSFONT, 1,
  72.                         NIL])
  73.   -> Blast some colourbars in screen's rastport, leave some colour 0 gaps.
  74.   j:=0
  75.   FOR i:=0 TO 15
  76.     SetAPen(genscreen.rastport, i)
  77.     RectFill(genscreen.rastport, j+1, 0, j+30, IF isPAL THEN 255 ELSE 199)
  78.     j:=j+40
  79.   ENDFOR
  80.   -> A line to show where borders start.
  81.   SetAPen(genscreen.rastport, 5)
  82.   Move(genscreen.rastport, 0, 0)
  83.   Draw(genscreen.rastport, genscreen.width-1, 0)
  84.   Draw(genscreen.rastport, genscreen.width-1, genscreen.height-1)
  85.   Draw(genscreen.rastport, 0, genscreen.height-1)
  86.   Draw(genscreen.rastport, 0, 0)
  87.  
  88.   -> Open a restricted window, no dragging or sizing, just closing (don't
  89.   -> want to refresh screen).
  90.   controlwindow:=OpenWindowTagList(NIL,
  91.                           [WA_TITLE, 'VideoControl',
  92.                            WA_LEFT, 210,
  93.                            WA_TOP, 20,
  94.                            WA_WIDTH, 220,
  95.                            WA_HEIGHT, 150,
  96.                            WA_CUSTOMSCREEN, genscreen,
  97.                            WA_FLAGS, WFLG_CLOSEGADGET OR WFLG_ACTIVATE OR
  98.                                      WFLG_NOCAREREFRESH,
  99.                            WA_IDCMP, IDCMP_CLOSEWINDOW OR IDCMP_GADGETUP,
  100.                            NIL])
  101.   -> OK, got a window, lets make some gadgets.
  102.   vi:=GetVisualInfoA(genscreen, [NIL])
  103.   gadget:=CreateContext({glist})
  104.   ng:=[controlwindow.borderleft+120, controlwindow.bordertop+2,
  105.        12, 12,
  106.        -> Just a demo, set everything to topaz 80.
  107.        'BORDERBLANK', ['topaz.font', 8, 0, 0]:textattr,
  108.        BORDERBLANK_ID, PLACETEXT_LEFT OR NG_HIGHLABEL,
  109.        vi, NIL]:newgadget
  110.   -> E-Note: the C version fails to check the return value of every single one
  111.   ->         of the calls to CreateGadgetA(), which is fatal since "gadget" is
  112.   ->         dereferenced as "gadget.height" (we are using automatic exceptions)
  113.   gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL])
  114.   gadgetPtrs[BORDERBLANK_ID]:=gadget
  115.  
  116.   ng.topedge:=ng.topedge+gadget.height+2
  117.   ng.gadgettext:='BORDERNOTRANS'
  118.   ng.gadgetid:=BORDERNOTRANS_ID
  119.   gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL])
  120.   gadgetPtrs[BORDERNOTRANS_ID]:=gadget
  121.  
  122.   ng.topedge:=ng.topedge+gadget.height+2
  123.   ng.gadgettext:='CHROMAKEY'
  124.   ng.gadgetid:=CHROMAKEY_ID
  125.   gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL])
  126.   gadgetPtrs[CHROMAKEY_ID]:=gadget
  127.  
  128.   ng.topedge:=ng.topedge+gadget.height+2
  129.   ng.gadgettext:='BITPLANEKEY'
  130.   ng.gadgetid:=BITPLANEKEY_ID
  131.   gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL])
  132.   gadgetPtrs[BITPLANEKEY_ID]:=gadget
  133.  
  134.   ng.topedge:=ng.topedge+gadget.height+2
  135.   ng.width:=90
  136.   ng.gadgettext:='CHROMAPLANE'
  137.   ng.gadgetid:=CHROMAPLANE_ID
  138.   gadget:=CreateGadgetA(CYCLE_KIND, gadget, ng,
  139.                [GTCY_LABELS, ['Plane 0', 'Plane 1', 'Plane 2', 'Plane 3', NIL],
  140.                 NIL])
  141.   gadgetPtrs[CHROMAPLANE_ID]:=gadget
  142.  
  143.   ng.topedge:=ng.topedge+gadget.height+20
  144.   ng.width:=12
  145.   ng.flags:=PLACETEXT_ABOVE OR NG_HIGHLABEL
  146.   FOR j:=0 TO 1
  147.     FOR i:=0 TO 7
  148.       ng.leftedge:=controlwindow.borderleft+2+(i*gadget.width)
  149.       -> E-Note: we can let E clear up all the E-strings we make
  150.       ng.gadgettext:=StringF(String(3), '\d', i+(j*8))
  151.       ng.gadgetid:=i+(j*8)
  152.       gadget:=CreateGadgetA(CHECKBOX_KIND, gadget, ng, [NIL])
  153.       -> E-Note: C version gets the index wrong
  154.       gadgetPtrs[i+(j*8)]:=gadget
  155.     ENDFOR
  156.     ng.topedge:=ng.topedge+gadget.height
  157.     ng.flags:=PLACETEXT_BELOW OR NG_HIGHLABEL
  158.   ENDFOR
  159.  
  160.   AddGList(controlwindow, glist, -1, -1, NIL)
  161.   RefreshGList(glist, controlwindow, NIL, -1)
  162.   Gt_RefreshWindow(controlwindow, NIL)
  163.  
  164.   -> Finally, a window with some gadgets...
  165.   ->
  166.   -> Get the current genlock state.  Obviously I already know what the settings
  167.   -> will be (all off), since I opened the screen myself.  Do it just to show
  168.   -> how to get them.
  169.   vp:=genscreen.viewport
  170.  
  171.   -> Is borderblanking on?
  172.   vtags[0].tag:=VTAG_BORDERBLANK_GET
  173.   vtags[0].data:=NIL
  174.  
  175.   -> Is bordertransparent set?
  176.   vtags[1].tag:=VTAG_BORDERNOTRANS_GET
  177.   vtags[1].data:=NIL
  178.  
  179.   -> Key on bitplane?
  180.   vtags[2].tag:=VTAG_BITPLANEKEY_GET
  181.   vtags[2].data:=NIL
  182.  
  183.   -> Get plane which is used to key on
  184.   vtags[3].tag:=VTAG_CHROMA_PLANE_GET
  185.   vtags[3].data:=NIL
  186.  
  187.   -> Chromakey overlay on?
  188.   vtags[4].tag:=VTAG_CHROMAKEY_GET
  189.   vtags[4].data:=NIL
  190.  
  191.   FOR i:=0 TO 15
  192.     -> Find out which colours overlay
  193.     vtags[i+5].tag:=VTAG_CHROMA_PEN_GET
  194.     vtags[i+5].data:=i
  195.   ENDFOR
  196.  
  197.   -> Indicate end of tag array
  198.   vtags[21].tag:=VTAG_END_CM
  199.   vtags[21].data:=NIL
  200.  
  201.   -> And send the commands.  On return the Tags themselves will indicate the
  202.   -> genlock settings for this ViewPort's ColorMap.
  203.   VideoControl(vp.colormap, vtags)
  204.  
  205.   -> And initialise the gadgets, according to genlock settings.
  206.  
  207.   IF vtags[0].tag=VTAG_BORDERBLANK_SET
  208.     Gt_SetGadgetAttrsA(gadgetPtrs[BORDERBLANK_ID], controlwindow, NIL,
  209.                       [GTCB_CHECKED, TRUE, NIL])
  210.   ENDIF
  211.   IF vtags[1].tag=VTAG_BORDERNOTRANS_SET
  212.     Gt_SetGadgetAttrsA(gadgetPtrs[BORDERNOTRANS_ID], controlwindow, NIL,
  213.                       [GTCB_CHECKED, TRUE, NIL])
  214.   ENDIF
  215.   IF vtags[2].tag=VTAG_BITPLANEKEY_SET
  216.     Gt_SetGadgetAttrsA(gadgetPtrs[BITPLANEKEY_ID], controlwindow, NIL,
  217.                       [GTCB_CHECKED, TRUE, NIL])
  218.   ENDIF
  219.   IF vtags[3].tag=VTAG_CHROMA_PLANE_SET
  220.     Gt_SetGadgetAttrsA(gadgetPtrs[CHROMAPLANE_ID], controlwindow, NIL,
  221.                       [GTCY_ACTIVE, vtags[3].data, NIL])
  222.   ENDIF
  223.   IF vtags[4].tag=VTAG_CHROMAKEY_SET
  224.     Gt_SetGadgetAttrsA(gadgetPtrs[CHROMAKEY_ID], controlwindow, NIL,
  225.                       [GTCB_CHECKED, TRUE, NIL])
  226.   ENDIF
  227.   FOR i:=0 TO 15
  228.     IF vtags[i+5].tag=VTAG_CHROMA_PEN_SET
  229.       -> E-Note: C version fails to terminate the tag list!
  230.       Gt_SetGadgetAttrsA(gadgetPtrs[i], controlwindow, NIL,
  231.                         [GTCB_CHECKED, TRUE, NIL])
  232.     ENDIF
  233.   ENDFOR
  234.  
  235.   -> Will only send single commands from here on.
  236.   vtags[1].tag:=VTAG_END_CM
  237.  
  238.   -> Get user input.
  239.   REPEAT
  240.     WaitPort(controlwindow.userport)
  241.     WHILE imsg:=Gt_GetIMsg(controlwindow.userport)
  242.       iclass:=imsg.class
  243.       icode:=imsg.code
  244.       hitgadget:=imsg.iaddress
  245.       Gt_ReplyIMsg(imsg)
  246.  
  247.       -> E-Note: C version uses obsolete tags
  248.       SELECT iclass
  249.       CASE IDCMP_GADGETUP
  250.         IF hitgadget.gadgetid < 16
  251.           IF hitgadget.flags AND GFLG_SELECTED
  252.             -> Set colour key
  253.             vtags[0].tag:=VTAG_CHROMA_PEN_SET
  254.           ELSE
  255.             -> Clear colour key
  256.             vtags[0].tag:=VTAG_CHROMA_PEN_CLR
  257.           ENDIF
  258.         ELSE
  259.           i:=hitgadget.gadgetid
  260.           SELECT i
  261.           CASE BORDERBLANK_ID
  262.             IF hitgadget.flags AND GFLG_SELECTED
  263.               -> Set border blanking on
  264.               vtags[0].tag:=VTAG_BORDERBLANK_SET
  265.             ELSE
  266.               -> Turn border blanking off
  267.               vtags[0].tag:=VTAG_BORDERBLANK_CLR
  268.             ENDIF
  269.           CASE BORDERNOTRANS_ID
  270.             IF hitgadget.flags AND GFLG_SELECTED
  271.               -> Set border transparency on
  272.               vtags[0].tag:=VTAG_BORDERNOTRANS_SET
  273.             ELSE
  274.               -> Turn border transparency off
  275.               vtags[0].tag:=VTAG_BORDERNOTRANS_CLR
  276.             ENDIF
  277.           CASE BITPLANEKEY_ID
  278.             IF hitgadget.flags AND GFLG_SELECTED
  279.               -> Key on current selected bitplane (chromaplane)
  280.               vtags[0].tag:=VTAG_BITPLANEKEY_SET
  281.             ELSE
  282.               -> Turn bitplane keying off
  283.               vtags[0].tag:=VTAG_BITPLANEKEY_CLR
  284.             ENDIF
  285.           CASE BITPLANEKEY_ID
  286.             IF hitgadget.flags AND GFLG_SELECTED
  287.               -> Key on current selected bitplane (chromaplane)
  288.               vtags[0].tag:=VTAG_BITPLANEKEY_SET
  289.             ELSE
  290.               -> Turn bitplane keying off
  291.               vtags[0].tag:=VTAG_BITPLANEKEY_CLR
  292.             ENDIF
  293.           CASE CHROMAPLANE_ID
  294.             -> Set plane to key on
  295.             vtags[0].tag:=VTAG_CHROMA_PLANE_SET
  296.             vtags[0].data:=icode
  297.           CASE BITPLANEKEY_ID
  298.             IF hitgadget.flags AND GFLG_SELECTED
  299.               -> Key on current selected bitplane (chromaplane)
  300.               vtags[0].tag:=VTAG_BITPLANEKEY_SET
  301.             ELSE
  302.               -> Turn bitplane keying off
  303.               vtags[0].tag:=VTAG_BITPLANEKEY_CLR
  304.             ENDIF
  305.           CASE CHROMAKEY_ID
  306.             IF hitgadget.flags AND GFLG_SELECTED
  307.               -> Set chromakey overlay on
  308.               vtags[0].tag:=VTAG_CHROMAKEY_SET
  309.             ELSE
  310.               -> Turn chromakey overlay off
  311.               vtags[0].tag:=VTAG_CHROMAKEY_CLR
  312.             ENDIF
  313.           ENDSELECT
  314.         ENDIF
  315.  
  316.         -> Send video command.
  317.         VideoControl(vp.colormap, vtags)
  318.         -> Get the View for this genlock screen.
  319.         viewlord:=ViewAddress()
  320.         -> And remake the ViewPort.
  321.         MakeVPort(viewlord, vp)
  322.         MrgCop(viewlord)
  323.         LoadView(viewlord)
  324.  
  325.       CASE IDCMP_CLOSEWINDOW
  326.         -> Get out of here.
  327.         abort:=TRUE
  328.       ENDSELECT
  329.     ENDWHILE
  330.   UNTIL abort
  331.  
  332.   RemoveGList(controlwindow, glist, -1)
  333.  
  334. EXCEPT DO
  335.   -> E-Note: works even if glist=NIL
  336.   FreeGadgets(glist)
  337.   IF vi THEN FreeVisualInfo(vi)
  338.   IF controlwindow THEN CloseWindow(controlwindow)
  339.   IF genscreen THEN CloseScreen(genscreen)
  340.   -> E-Note: the E-strings used for gadget text will be freed automatically
  341.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  342.   imsg:=NIL  -> E-Note: get ready to receive a possible error message
  343.   SELECT exception
  344.   CASE ERR_CTXT;  imsg:='Can''t create gadget context'
  345.   CASE ERR_ECS;   imsg:='Requires ECS'
  346.   CASE ERR_GAD;   imsg:='Can''t create gadget'
  347.   CASE ERR_KICK;  imsg:='Requires V37'
  348.   CASE ERR_LIB;   imsg:='Unable to open gadtools.library'
  349.   CASE ERR_SCRN;  imsg:='Can''t open screen'
  350.   CASE ERR_VIS;   imsg:='Can''t get visual info'
  351.   CASE ERR_WIN;   imsg:='Can''t open window'
  352.   CASE "MEM";     imsg:='Out of memory'
  353.   ENDSELECT
  354.   IF imsg THEN EasyRequestArgs(NIL, [SIZEOF easystruct, 0, 'GenlockDemo',
  355.                                      '\s', 'Continue']:easystruct,
  356.                                NIL, [imsg])
  357. ENDPROC
  358. ->>>
  359.  
  360. ->>> PROC checkPAL(screenname)
  361. -> Generic routine to check for a PAL System.  CheckPAL returns TRUE, if the
  362. -> videomode of the specified public screen (or default videmode) is PAL.  If
  363. -> the screenname is NIL, the default public screen will be used.
  364. PROC checkPAL(screenname)
  365.   DEF screen:PTR TO screen, modeID=LORES_KEY, displayinfo:displayinfo, isPAL
  366.   IF gfx.lib.version>=36
  367.     -> We got V36, so lets use the new calls to find out what kind of videomode
  368.     -> the user (hopefully) prefers.
  369.     IF screen:=LockPubScreen(screenname)
  370.       -> Use graphics.library/GetVPModeID() to get the ModeID of the specified
  371.       -> screen.  Will use the default public screen (Workbench most of the
  372.       -> time) if NIL.  It is _very_ unlikely that this would be invalid, heck
  373.       -> it's impossible.
  374.       IF INVALID_ID<>(modeID:=GetVPModeID(screen.viewport))
  375.         -> If the screen is in VGA mode, we can't tell whether the system is PAL
  376.         -> or NTSC.  So to be foolproof we fall back to the displayinfo of the
  377.         -> default.monitor by inquiring about just the LORES_KEY displaymode if
  378.         -> we don't know.  The default.monitor reflects the initial video setup
  379.         -> of the system, thus is an alias for either ntsc.monitor or
  380.         -> pal.monitor.  We only use the displaymode of the specified public
  381.         -> screen if it's display mode is PAL or NTSC and NOT the default.
  382.         IF ((modeID AND MONITOR_ID_MASK)<>NTSC_MONITOR_ID) AND
  383.            ((modeID AND MONITOR_ID_MASK)<>PAL_MONITOR_ID)
  384.           modeID:=LORES_KEY
  385.         ENDIF
  386.       ENDIF
  387.       UnlockPubScreen(NIL, screen)
  388.     ENDIF
  389.     -> If fails modeID=LORES_KEY.  Can't lock screen, so fall back on
  390.     -> default monitor.
  391.     IF GetDisplayInfoData(NIL, displayinfo, SIZEOF displayinfo,
  392.                           DTAG_DISP, modeID)
  393.       -> Currently the default monitor is always either PAL or NTSC.
  394.       isPAL:=displayinfo.propertyflags AND DIPF_IS_PAL
  395.     ENDIF
  396.   ELSE
  397.     -> < V36.  The enhancements to the videosystem in V36 cannot be better
  398.     -> expressed than with the simple way to determine PAL in V34.
  399.     isPAL:=gfx.displayflags AND PAL
  400.   ENDIF
  401. ENDPROC isPAL
  402. ->>>
  403.  
  404.